home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TINYPASC.LZH / TUUTILS.PAS < prev   
Pascal/Delphi Source File  |  1986-02-17  |  2KB  |  82 lines
  1.   { TUUTILS -- contains YESRESP, ASSERT, IS_SPECIAL, etc. }
  2.  
  3.   {**********************}
  4.   function RESP(MSG: string80): char;
  5.     var CH: char;
  6.   begin
  7.     write(msg);
  8.     read(kbd, ch);  writeln(ch);
  9.     resp:=ch;
  10.     end;
  11.   
  12.   {*********************}
  13.   function YESRESP (MSG: string80): boolean;
  14.     var CH: char;
  15.   begin
  16.     yesresp:=resp(msg) in ['y', 'Y'];
  17.     end;
  18.  
  19.   {*********************}
  20.   procedure ESCAPE(code: integer);
  21.   begin
  22.     writeln;
  23.     writeln('Fatal error; code ', code:1);
  24.     writeln(rfile, ' ':255); halt(code);
  25.     end;
  26.  
  27.   {********************}
  28.   function StrCmp(S, T: string80): integer;
  29.   { return -1 if s<t; 0 if s=t; 1 if s>t }
  30.   var Result: integer;
  31.   begin
  32.          if s = t then StrCmp := 0
  33.     else if s < t then StrCmp := -1
  34.     else if s > t then StrCmp := 1
  35.   end;
  36.  
  37.   {*********************}
  38.   procedure ASSERT (COND: boolean; MSG: string80) ;
  39.   begin
  40.     if not(cond) then
  41.     begin
  42.       writeln;
  43.       writeln('Internal assertion failure: ', msg);
  44.       writeln('Please notify Support person in charge');
  45.       escape(999)
  46.     end
  47.   end;
  48.  
  49.   {*********************}
  50.   function NUM2STRING (N: integer): string8;
  51.   var   S: string8;
  52.         RETURNCODE: integer;
  53.   begin
  54.     s := '';
  55.     str(n, s);
  56.     num2string:=s;
  57.   end;
  58.  
  59.   {*****************}
  60.   procedure OPENCOM;
  61.   begin
  62.     end;
  63.  
  64.   {*****************}
  65.   function OPENFILE(var TFILE: text;
  66.                     FNAME: string80; FOR_WRITE: boolean): boolean;
  67.     var SUCCESS: boolean;
  68.         ERRCODE: integer;
  69.   begin
  70.    {$I-}
  71.     assign(tfile, fname);
  72.     if for_write then rewrite(tfile)
  73.     else reset(tfile);
  74.     success := (ioresult = 0);
  75.     errcode := ioresult;
  76.    {$I+}
  77.     if not success then
  78.       writeln('Can''t open file ', fname, ' -- code ', errcode:1);
  79.     openfile:=success;
  80.     end;
  81.  
  82.